home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1995 April / Internet Tools.iso / infoserv / gopher / Unix / gopher-gateways / gonnrp / gonnrp-2.3.Z / gonnrp-2.3
Encoding:
Text File  |  1994-04-19  |  9.2 KB  |  349 lines
  1. #!/bin/perl 
  2. # Gopher-nnrp Gateway
  3. # 12-Apr-1994 version 2.3 Chad Adams c-adams@bgu.edu
  4. # support INN running on solaris and 'mode reader' nntp command
  5. #
  6. # 08-Jun-1993 version 2.2 Chad Adams (c-adams@bgu.edu)
  7. # remove hardcoded paths and make -G with no param work
  8. #
  9. # 28-May-1993 version 2.1 Chad Adams (c-adams@bgu.edu)
  10. # build in access control for clari groups.  Make errors returned the same
  11. #   format as server errors so our version of gopher will put them in pop
  12. #   up box.
  13. #
  14. # 28-May-1993 version 2.0 Chad Adams (c-adams@bgu.edu)
  15. # major rewrite by: Chad Adams
  16. # add newgroups database.
  17. # add multi level newsgroup menus.  [each .part. of newsgroup automaticly
  18. #   gets it's own menu instead of putting all (like all of comp) in one
  19. #   menu.  {now menus like comp.sys, comp.lang, comp.sources, ect..}]
  20. # convert to use xhdr instead of tin's xindex.  If not used with INN using
  21. #   overview files to speed up xhdr it may be slow.
  22. #
  23. # Gopher-NNTP Gateway version 1.0
  24. # Author: Daniel Schales (dan@engr.latech.edu)
  25. # Major rewrite, socket support: Doug Schales (d1s8027@sc.tamu.edu)
  26. #
  27. # Set the 4 following variables for your setup. the 2 port variables
  28. # are set to the standard, be sure to set gopherhost and nntphost to
  29. # your respective hosts.
  30. $gopherhost="your.host.here";
  31. $gopherport=2008;
  32. $nntphost="your.host.here";
  33. $nntpprt='nntp';
  34. $nntpeol="\r\n";
  35.  
  36. $gonnrp = $0; # path to this script
  37. $newsdbm = '/usr/lib/newsgroups'; # where the newsgroups dbm files are
  38.  
  39. # localaddr for clari access.  Example:
  40. # @localaddr(143, 43, 139, 67);
  41. # allows access to 143.43.*.* and 139.67.*.*
  42. @localaddr = (143, 43, 139, 67);
  43.  
  44. @INC=("/usr/local/lib/perl");
  45. require 'sys/socket.ph';
  46. dump QUICKSTART if @ARGV[0] eq '-dump';
  47. QUICKSTART:
  48.  
  49. $SIG{'ALRM'} = 'stuck';
  50. $option=shift;
  51. $option = '-h' if $option eq '-t';
  52. while ($option eq '-f') {
  53.       $copyright = shift;
  54.       $option = shift;
  55.       open(CR, $copyright);
  56.       $title = <CR>;
  57.       close(CR);
  58.       chop($title);
  59.       print "0$title\t$copyright\t$gopherhost\t$gopherport\r\n";
  60. }
  61. $item=shift;
  62. if ($option eq '-X') {
  63.     @arts = @ARGV;
  64. } else {
  65.     $lookup=shift;
  66. }
  67. if (-S STDIN && ($item =~ m/^clari/)) {
  68.     $sockaddr = 'S n a4 x8';
  69.     ($fam, $proto, $addr) = unpack($sockaddr,getpeername(STDIN));
  70.     @inetaddr = unpack('C4',$addr);
  71.     for ($i = 0; $i < $#localaddr; $i += 2) {
  72.         $validaccess = 1 if @localaddr[$i] == @inetaddr[0] &&
  73.             @localaddr[$i+1] == @inetaddr[1];
  74.     }
  75.     $_ = 'Off site access not allowed to clari newsgroups  ';
  76.     &checkcode($validaccess,1);
  77. }
  78.  
  79. # set an alarm 5 minutes from now, if it goes off we must be stuck
  80. alarm(300);
  81. open(LOG,">>/tmp/nntplog");
  82. $date=`date`;chop($date);
  83. print LOG $date," ",$option," ",$item," ",$lookup,"\n";
  84. close(LOG);
  85. $sockaddr = 'S n a4 x8';
  86. ($name, $aliases, $proto) = getprotobyname('tcp');
  87. ($name, $aliases, $nntpport) = getservbyname($nntpprt, 'tcp');
  88. ($name, $aliases, $type, $len, $nntpaddr) = gethostbyname($nntphost);
  89.  
  90. $rsockaddr = pack($sockaddr, &AF_INET, $nntpport, $nntpaddr);
  91.  
  92. socket(NNTPSOCK, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
  93. connect(NNTPSOCK, $rsockaddr) || die "connect: $!";
  94.  
  95. select(NNTPSOCK); $|= 1; select(stdout);
  96.  
  97. $_ = <NNTPSOCK>;
  98. print NNTPSOCK "MODE READER$nntpeol";
  99. $_ = <NNTPSOCK>;
  100.  
  101. if ($option eq '-g') {
  102.     dbmopen(newsgroups, $newsdbm, 0444);
  103.     print NNTPSOCK "LIST$nntpeol";
  104.     $_ = <NNTPSOCK>;
  105.     chop; chop;
  106.     while($_ ne "."){
  107.     if($_ =~ "^$item"){
  108.         ($group) = split;
  109.         push(@out,"1$group - $newsgroups{$group}\texec:-h $group:".
  110.             "$gonnrp\t$gopherhost\t$gopherport\r\n");
  111.     }
  112.     $_ = <NNTPSOCK>;
  113.     chop; chop;
  114.     }
  115.     print sort(@out);
  116.     print ".\r\n";
  117. } elsif ($option eq '-G') {
  118.     dbmopen(newsgroups, $newsdbm, 0444);
  119.     print NNTPSOCK "LIST$nntpeol";
  120.     $_ = <NNTPSOCK>;
  121.     chop; chop;
  122.     if ($item ne '') {
  123.     $itemlen = length($item) + 1;
  124.     $dot = '.';
  125.     } else {
  126.     $itemlen = 0;
  127.     $dot = '';
  128.     }
  129.     @grouplist = ();
  130.     while($_ ne "."){
  131.     if($_ =~ "^$item"){
  132.             ($group) = split;
  133.         push(@grouplist, $group);
  134.     }
  135.         $_ = <NNTPSOCK>;
  136.         chop; chop;
  137.     }
  138.     @grouplist = sort(@grouplist);
  139.     for ($i = 0; $i <= $#grouplist; $i++) {
  140.         $group = @grouplist[$i];
  141.         if ($group eq $item) {
  142.         $grp = $group;
  143.             print "1$newsgroups{$group}\texec:-T $group:".
  144.             "$gonnrp\t$gopherhost\t$gopherport\r\n";
  145.         } else {
  146.         $grp = substr($group,$itemlen,40);
  147.         if (index($grp,'.') != -1) {
  148.             @grppart = split(/\./,$grp);
  149.             if (@grppart[0] eq $oldgrp) {
  150.             next;
  151.             }
  152.             $oldgrp = @grppart[0];
  153.             $grp = @grppart[0];
  154.                 print "1$grp - ".$newsgroups{"$item$dot$grp.all"}.
  155.             "\texec:-G $item$dot$grp".
  156.             ":$gonnrp\t$gopherhost\t$gopherport\r\n";
  157.         } else {
  158.             if ($group eq substr(@grouplist[$i+1],0,length($group))) {
  159.                     print "1$grp - ".$newsgroups{"$item$dot$grp.all"}.
  160.                 "\texec:-G $group:".
  161.                 "$gonnrp\t$gopherhost\t$gopherport\r\n";
  162.             $oldgrp = $grp;
  163.             } else {
  164.                     print "1$grp - $newsgroups{$group}\texec:-T $group:".
  165.                 "$gonnrp\t$gopherhost\t$gopherport\r\n";
  166.             }
  167.         }
  168.         }
  169.     }
  170.     print ".\r\n";
  171. } elsif($option eq '-X') {
  172. #    $item = newsgroup
  173. #    @arts = articles in this thread
  174. #      or
  175. #    @arts = 0 low high  if list would be too long
  176.     ($code) = &group($item);
  177.     # build arts array if we were passed range
  178.     @arts = split(' ', &buildidx(@arts[1], @arts[2])) if @arts[0] == 0;
  179.     foreach $art (@arts) { $goodart{$art} = 1; }
  180.     &xhdr('from', @arts[0], @arts[$#arts]);
  181.     while (<NNTPSOCK>) {
  182.         last if substr($_,0,1) eq '.';
  183.         chop; chop;
  184.         ($art, $from) = split(/ /,$_,2);
  185.         print "0$from\texec:-a ${item} $art:$gonnrp\t".
  186.             "$gopherhost\t$gopherport\r\n" if $goodart{$art};
  187.     }
  188.     print ".\r\n";
  189. } elsif($option eq '-T') {
  190.     ($code, $cnt, $low, $high) = &group($item);
  191.     &buildidx($low, $high);
  192.     @keys = sort(keys %idx);
  193.     foreach $key (@keys) {
  194.         @arts = split(' ',$idx{$key});
  195.         if ($#arts == 0) { # single article
  196.             print "0$key\texec:-a ${item} @arts[0]:".
  197.               "$gonnrp\t$gopherhost\t$gopherport\r\n";
  198.         } else { # thread
  199.             if (length($idx{$key}) < 80) { # send article list
  200.                 print "1$key\texec:-X $item$idx{$key}:".
  201.                   "$gonnrp\t$gopherhost\t$gopherport\r\n";
  202.             } else { # give range
  203.                 print "1$key\texec:".
  204.                   "-X $item 0 @arts[0] @arts[$#arts]:".
  205.                   "$gonnrp\t$gopherhost\t$gopherport\r\n";
  206.             }
  207.         }
  208.     }
  209.     print ".\r\n";
  210. } elsif($option eq '-l'){
  211.     ($code, $count, $start, $end) = &group($item);
  212.     if($count ne "0"){
  213.         print NNTPSOCK "ARTICLE $end$nntpeol";
  214.         $body=0;
  215.         $_ = <NNTPSOCK>;
  216.         chop; chop;
  217.         while($_ ne "."){
  218.             if ($body) {
  219.                 print "$_\r\n";
  220.             } elsif ($_ =~ "^220 " || $_ =~ "^222 ") {
  221.                 $body = 1;
  222.             }
  223.         }
  224.              $_ = <NNTPSOCK>;
  225.              chop; chop;
  226.      }
  227. }
  228. # rwp 20Aug92 Add ability to fetch last article.
  229.  
  230. elsif($option eq '-h' || $option eq '-b' || $option eq '-s'){
  231.     ($code, $count, $start, $end) = &group($item);
  232.     if($count ne "0"){
  233.         &xhdr('subject', $start, $end);
  234.         $_ = <NNTPSOCK>;
  235.         chop; chop;
  236.         while($_ ne '.'){
  237.             ($num,$desc) = split (/ /,$_,2);
  238.             if ($option eq '-h' ) {
  239.                 print "0$desc\texec:-a ${item} ${num}:".
  240.                   "$gonnrp\t$gopherhost\t$gopherport\r\n";
  241.             } elsif ($option eq '-b') {
  242.                 print "0$desc\texec:-a ${item} ${num} body".
  243.                   ":$gonnrp\t$gopherhost\t$gopherport\r\n";
  244.             } elsif ($option eq '-s') {
  245.                 $desc1="\L$desc\E";
  246.                 $lookup1 ="\L$lookup\E";
  247.                 if ($desc1 =~ $lookup1 ) {
  248.                  print "0$desc\texec:-a ${item} ${num}:".
  249.                   "$gonnrp\t$gopherhost\t$gopherport\t\r\n";
  250.                 }
  251.             }
  252.             $_ = <NNTPSOCK>;
  253.             chop; chop;
  254.         }
  255.     }
  256.     print ".\r\n";
  257. } elsif($option eq '-a'){
  258.     $num = $lookup;
  259.     $part = shift;
  260.     ($code) = &group($item);
  261.     if($part eq "body") {
  262.         print NNTPSOCK "BODY $num$nntpeol";
  263.         ($code) = split(/ /,($_ = <NNTPSOCK>));
  264.         &checkcode($code,222);
  265.     } else {
  266.         print NNTPSOCK "ARTICLE $num$nntpeol";
  267.         ($code) = split(/ /,($_ = <NNTPSOCK>));
  268.         &checkcode($code,220);
  269.     }
  270.     $_ = <NNTPSOCK>;
  271.     chop; chop;
  272.     while($_ ne "."){
  273.         print "$_\r\n";
  274.         $_ = <NNTPSOCK>;
  275.         chop; chop;
  276.     }
  277. }
  278.  
  279. print NNTPSOCK "QUIT$nntpeol";
  280. shutdown(NNTPSOCK, 2);
  281. exit(0);
  282.  
  283. sub stuck {
  284. open(LOG,">>/tmp/nntplog");
  285. $date=`date`;chop($date);
  286. print LOG $date," hung on ",$option," ",$item," ",$lookup,"\n";
  287. close(LOG);
  288.  
  289. exit;
  290. }
  291.  
  292. # Chad Adams  28-May-1993  tin's xindex to xhdr conversion
  293. sub checkcode { # return error when nntp command failes
  294.     local($code, $goodcode) = @_;
  295.     if ($code != $goodcode) {
  296.         chop; chop;
  297.         print "0nnrp error: $_\t\terror.host\t1\r\n";
  298.         print ".\r\n";
  299.         exit;
  300.     }
  301. }
  302. sub buildidx {    # build subject threads
  303.     local ($low, $high) = @_;
  304.     local ($first, $fsubj, $re, $subj);
  305.     $first = 1;
  306.     &xhdr('subject', $low, $high);
  307.     $cnt = 0;
  308.     while (<NNTPSOCK>) {
  309.         last if substr($_,0,1) eq '.';
  310.         chop; chop;
  311.         ($art, $subj) = split(/ /,$_,2);
  312.         while (1) { # remove Re:
  313.             $re = substr($subj,0,2);
  314.             $re =~ tr/A-Z/a-z/;
  315.             if ($re eq 're') {
  316.                 $subj = substr($subj,2);
  317.                 next;
  318.             } elsif (substr($subj,0,1) eq ':') {
  319.                 $subj = substr($subj,1);
  320.                 next;
  321.             } elsif (substr($subj,0,1) eq ' ') {
  322.                 $subj = substr($subj,1);
  323.                 next;
  324.             }
  325.             last;
  326.         }
  327.         if ($first) {
  328.             $fsubj = $subj;
  329.             $first = 0;
  330.         }
  331.         $idx{$subj} .= " $art";
  332.         $cnt++;
  333.     }
  334.     return $idx{$fsubj};
  335. }
  336. sub group { # (code, count, low, high) = &group(newsgroup)
  337.     local(@rtn);
  338.     print NNTPSOCK "group @_[0]$nntpeol";
  339.     @rtn = split(/ /,($_ = <NNTPSOCK>), 5);
  340.     &checkcode(@rtn[0],211);
  341.     return @rtn;
  342. }
  343. sub xhdr { # &xhdr(header,low,high)
  344.     local($code);
  345.     print NNTPSOCK "xhdr @_[0] ".@_[1].'-'.@_[2].$nntpeol;
  346.     ($code) = split(/ /,($_ = <NNTPSOCK>));
  347.     &checkcode($code,221);
  348. }
  349.